home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Source Code
/
Visual Basic Source Code.iso
/
vbsource
/
attall
/
moon.bas
< prev
next >
Wrap
BASIC Source File
|
1995-05-09
|
10KB
|
209 lines
DefDbl A-Z
Global CurM$
Global MoonNum
Global MoonSUb
Sub CalcMoonPhases (YearI%, MonthI%, DayI%, Offset As Integer)
Static DayC(1 To 35) As String
'The original program is in lib 7 of the astronomy forum
'(GO ASTROFORUM) as MOONPH.BAS
100 '*************************************************************************
200 '* PHASES OF THE MOON *
300 '* *
400 '* Programmer: Daniel P. Franco *
500 '* *
600 '* VERSION 1.0.0 *
700 '* March 8, 1987 *
800 '* [73307,3471] *
900 '* *
1000 '* This program calculates the phase of the moon for a given YearP *
1100 '* and MonthP. The user inputs the YearP, the MonthP, and the number of *
1200 '* consecutive MonthPs data are required for. Output includes Ephemeris *
1300 '* Time of each phase beginning with the new moon. *
1400 '* *
1500 '*************************************************************************
1600 '*************************************************************************
1700 '* *
1800 '* INPUT SECTION *
1900 '* *
2000 '*************************************************************************
'This routine seems to work. We haven't a clue how, but...
'Praise Daniel! Good stuff...
For i% = 1 To 35
DayC(i%) = ""
Next i%
YearP = YearI%
MonthP = MonthI%
MonthP = MonthP - 1
If MonthP = 0 Then
MonthP = 12
YearP = YearP - 1
End If
2500 LEAP = YearP Mod 4 'if leap = 0 then YearP is a leap YearP
2900 COUNT = 3
'YD = 0
3000 If LEAP <> 0 Then 3400 Else 4700
3100 '**************************************************************************
3200 '* CALCULATION FOR DECIMAL YearPS *
3300 '**************************************************************************
3400 If MonthP = 1 Then YD = 4.24375935815675E-02
3500 If MonthP = 2 Then YD = .123205916849712
3600 If MonthP = 3 Then YD = .203974240117857
3700 If MonthP = 4 Then YD = .287480472649328
3800 If MonthP = 5 Then YD = .3709867051808
3900 If MonthP = 6 Then YD = .454492937712271
4000 If MonthP = 7 Then YD = .537999170243743
4100 If MonthP = 8 Then YD = .622874357406878
4200 If MonthP = 9 Then YD = .706380589938349
4300 If MonthP = 10 Then YD = .789886822469821
4400 If MonthP = 11 Then YD = .873393055001292
4500 If MonthP = 12 Then YD = .956899287532764
4600 GoTo 6000
4700 If LEAP = 0 GoTo 4800
4800 If MonthP = 1 Then YD = 4.24375935815675E-02
4900 If MonthP = 2 Then YD = .124574871481376
5000 If MonthP = 3 Then YD = .20534319474952
5100 If MonthP = 4 Then YD = .288849427280992
5200 If MonthP = 5 Then YD = .372355659812463
5300 If MonthP = 6 Then YD = .455861892343935
5400 If MonthP = 7 Then YD = .539368124875406
5500 If MonthP = 8 Then YD = .624243312038541
5600 If MonthP = 9 Then YD = .707749544570013
5700 If MonthP = 10 Then YD = .791255777101484
5800 If MonthP = 11 Then YD = .874762009632956
5900 If MonthP = 12 Then YD = .958268242164428
6000 K = ((YearP + YD) - 1900) * 12.3685
6100 K = CInt(K)
6200 COUNT = K + COUNT
6300 T = K / 1236.85
6400 T2 = T ^ 2
6500 T3 = T ^ 3
6600 PI = 3.14159265358979
6700 R = PI / 180
6800 '**************************************************************************
6900 '* SUN MEAN ANOMALY *
7000 '**************************************************************************
7100 SMA = 359.2242 + (29.10535608 * K) - (.0000333 * T2) - (.00000347 * T3)
7200 If SMA > 360 Then SMA = SMA / 360: SMA = SMA - Fix(SMA): SMA = SMA * 360
7300 '**************************************************************************
7400 '* MOON MEAN ANOMALY *
7500 '**************************************************************************
7600 MMA = 306.0253 + (385.81691806 * K) + (.0107306 * T2) + (.00001236 * T3)
7700 If MMA > 360 Then MMA = MMA / 360: MMA = MMA - Fix(MMA): MMA = MMA * 360
7800 '**************************************************************************
7900 '* MOON'S ARGUMENT OF LATITUDE *
8000 '**************************************************************************
8100 F = 21.2964 + (390.67050646 * K) - (.0016528 * T2) - (.00000239 * T3)
8200 If F > 360 Then F = F / 360: F = F - Fix(F): F = F * 360
8300 '**************************************************************************
8400 '* MEAN PHASE OF THE MOON *
8500 '**************************************************************************
8600 JD = 2415020.75933 + (29.53058868 * K) + (.0001178 * T2) - (.000000155 * T3) + (.00033 * Sin((R * 166.56) + (R * 132.87) * T) - ((R * .009173 * T2)))
8700 SMA = SMA * R
8800 MMA = MMA * R
8900 F = F * R
9000 '**************************************************************************
9100 '* TRUE PHASE CORRECTIONS FOR NEW AND FULL MOON *
9200 '**************************************************************************
9300 If K - Fix(K) = 0 Or K - Fix(K) = .5 Or K - Fix(K) = -.5 Then 9400 Else 11100
9400 JD = JD + ((.1734 - .000393 * T) * Sin(SMA))
9500 JD = JD + (.0021 * Sin(2 * SMA))
9600 JD = JD - (.4068 * Sin(MMA))
9700 JD = JD + (.0161 * Sin(2 * MMA))
9800 JD = JD - (.0004 * Sin(3 * MMA))
9900 JD = JD + (.0104 * Sin(2 * F))
10000 JD = JD - (.0051 * Sin(SMA + MMA))
10100 JD = JD - (.0074 * Sin(SMA - MMA))
10200 JD = JD + (.0004 * Sin((2 * F) + SMA))
10300 JD = JD - (.0004 * Sin((2 * F) - SMA))
10400 JD = JD - (.0006000001 * Sin((2 * F) + MMA))
10500 JD = JD + (.001 * Sin((2 * F) - MMA))
10600 JD = JD + .0005 * Sin(SMA + (2 * MMA))
10700 GoTo 14300
10800 '*************************************************************************
10900 '* TRUE PHASE CORRECTIONS FOR FOR FIRST AND LAST QUARTER *
11000 '*************************************************************************
11100 JD = JD + (.1721 - .0004 * T) * Sin(SMA)
11200 JD = JD + .0021 * Sin(2 * SMA)
11300 JD = JD - .628 * Sin(MMA)
11400 JD = JD + .0089 * Sin(2 * MMA)
11500 JD = JD - .0004 * Sin(3 * MMA)
11600 JD = JD + .0079 * Sin(2 * F)
11700 JD = JD - .0119 * Sin(SMA + MMA)
11800 JD = JD - .0047 * Sin(SMA - MMA)
11900 JD = JD + .0003 * Sin(2 * F + SMA)
12000 JD = JD - .0004 * Sin(2 * F - SMA)
12100 JD = JD - .0006000001 * Sin(2 * F + MMA)
12200 JD = JD + .0021 * Sin(2 * F - MMA)
12300 JD = JD + .0003 * Sin(SMA + 2 * MMA)
12400 JD = JD + .0004 * Sin(SMA - 2 * MMA)
12500 JD = JD - .0003 * Sin(2 * SMA - MMA)
12600 '*************************************************************************
12700 '* ADDITIONAL FIRST QUARTER CORRECTION *
12800 '*************************************************************************
12900 If K >= 0 And K - Fix(K) = .25 Then 13100 Else 13000
13000 If K < 0 And K - Fix(K) = -.75 Then 13100 Else 13600
13100 JD = JD + .0028 - .0004 * Cos(SMA) + .0003 * Cos(MMA)
13200 GoTo 14300
13300 '*************************************************************************
13400 '* ADDITIONAL LAST QUARTER CORRECTION *
13500 '*************************************************************************
13600 If K >= 0 And K - Fix(K) = .75 Then 13800 Else 13700
13700 If K < 0 And K - Fix(K) = -.25 Then 13800 Else 14300
13800